home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / winver.exe / WINVER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-04  |  14.7 KB  |  452 lines

  1. (*      WinVer 1.0
  2.         Stamps Windows EXEs or DLLs with the
  3.         required Windows version (3.00 or 3.10)
  4.         Author:   Costas Kitsos
  5.         CIS mail: 73667,1755
  6. *)
  7.  
  8. Program WINVER;
  9.  
  10. {$D WinVer 1.0 - Copyright (c) 1992, Costas Kitsos}
  11. {$I-,S-}
  12. {$R WinVer.RES}
  13.  
  14. Uses WinTypes, WinProcs, Strings, WinDos, WObjects;
  15.  
  16. CONST          {Dialog Control Constants}
  17.    id_Path   = 101;
  18.    id_File   = 102;
  19.    id_Dir    = 103;
  20.    id_Ver31  = 104;
  21.    id_Ver30  = 105;
  22.    id_Update = 106;
  23.    id_Finfo  = 107;
  24.    id_Types  = 108;
  25.    id_About  = 109;
  26.  
  27. CONST          {Program Constants}
  28.    TheApp: PChar = 'WinVer';
  29.    fsFileSpec    = fsFileName + fsExtension;
  30.    BufSize       = 32768;
  31.  
  32. { Source for TEXEHDR and TNEWHDR: Microsoft Systems Journal Vol 6, No 5}
  33.  
  34. Type TEXEHDR=record                    { DOS 1, 2, 3, 4 .EXE header }
  35.  ehSignature:                 Word;    { signature bytes }
  36.  ehcbLP:                      Word;    { bytes on last page of file }
  37.  ehcp:                        Word;    { pages in file }
  38.  ehcRelocation:               Word;    { count of relocation table entries}
  39.  ehcParagraphHdr:             Word;    { size of header in paragraphs }
  40.  ehMinAlloc:                  Word;    { minimum extra paragraphs needed }
  41.  ehMaxAlloc:                  Word;    { maximum extra paragraphs needed }
  42.  ehSS:                        Word;    { initial (relative) SS value }
  43.  ehSP:                        Word;    { initial SP value }
  44.  ehChecksum:                  Word;    { checksum }
  45.  ehIP:                        Word;    { initial IP value }
  46.  ehCS:                        Word;    { initial (relative) CS value }
  47.  ehlpRelocation:              Word;    { file address of relocation table }
  48.  ehOverlayNo:                 Word;    { overlay number }
  49.  ehReserved: array [0..15] of Word;    { reserved words }
  50.  ehPosNewHdr:                 LongInt; { file address of new exe header }
  51. end;
  52.  
  53. Type TNEWHDR=record                    { new .EXE header }
  54.  nhSignature:                Word;     { signature bytes }
  55.  nhVer:                      Char;     { LINK version number }
  56.  nhRev:                      Char;     { LINK revision number }
  57.  nhoffEntryTable:            Word;     { offset of Entry Table }
  58.  nhcbEntryTable:             Word;     { number of bytes in Entry Table }
  59.  nhCRC:                      LongInt;  { checksum of whole file }
  60.  nhFlags:                    Word;     { flag word }
  61.  nhAutoData:                 Word;     { automatic data segment number }
  62.  nhHeap:                     Word;     { initial heap allocation }
  63.  nhStack:                    Word;     { initial stack allocation }
  64.  nhCSIP:                     LongInt;  { initial CS:IP setting }
  65.  nhSSSP:                     LongInt;  { initial SS:SP setting }
  66.  nhcSeg:                     Word;     { count of file segments }
  67.  nhcMod:                     Word;     { entries in Module Reference Table}
  68.  nhcbNonResNameTable:        Word;     { size of non-resident name table }
  69.  nhoffSegTable:              Word;     { offset of Segment Table }
  70.  nhoffResourceTable:         Word;     { offset of Resource Table }
  71.  nhoffResNameTable:          Word;     { offset of Resident Name Table }
  72.  nhoffModRefTable:           Word;     { offset of Module Reference Table }
  73.  nhoffImpNameTable:          Word;     { offset of Imported Names Table }
  74.  nhoffNonResNameTable:       LongInt;  { offset of Non-resident Names Tab }
  75.  nhcMovableEntries:          Word;     { count of movable entries }
  76.  nhcAlign:                   Word;     { segment alignment shift count }
  77.  nhCRes:                     Word;     { count of resource segments }
  78.  nhExeType:                  Byte;     { target OS (OS/2=1, Windows=2) }
  79.  nhFlagsOther:               Byte;     { additional exe flags }
  80.  nhGangStart:                Word;     { offset to gangload area }
  81.  nhGangLength:               Word;     { length of gangload area }
  82.  nhSwapArea:                 Word;     { minimum code swap area size}
  83.  nhExpVer:                   Word;     { expected Windows version number }
  84. end;
  85.  
  86. CONST             {Executable Constants}
  87.    OLD_EXESign  = $5A4D; {Old EXE Signature}
  88.    NEW_EXESign  = $454E; {New EXE Signature}
  89.    WIN_OS: Byte = 2;     {Windows Operating System}
  90.    WIN_31: Word = $30A;  {ver Win 3.1}
  91.    WIN_30: Word = $300;  {ver Win 3.0}
  92.  
  93.  
  94. type
  95.   TWinVerApp = object(TApplication)
  96.     procedure InitInstance; virtual;
  97.     procedure InitMainWindow; virtual;
  98.   end;
  99.  
  100.   PWinVerWindow = ^TWinVerWindow;
  101.   TWinVerWindow = object(TDlgWindow)
  102.     FileName: array[0..fsPathName] of Char;
  103.     Extension: array[0..fsExtension] of Char;
  104.     FileSpec: array[0..fsFileSpec] of Char;
  105.     constructor Init(AParent : PWindowsObject; ATitle : PChar);
  106.     procedure SetupWindow ; virtual;
  107.     function GetClassName : PChar; virtual;
  108.     function UpdateListBoxes: Boolean;
  109.     function GetFileName: Boolean;
  110.     function UpdateFile(bVer31: Boolean) : Boolean;
  111.     procedure GetWindowClass(var AWndClass : TWndClass); virtual;
  112.     procedure idFile(var Msg : TMessage); virtual + id_First + id_File;
  113.     procedure idDir(var Msg : TMessage); virtual + id_First + id_Dir;
  114.     procedure idUpdate(var Msg : TMessage); virtual + id_First + id_Update;
  115.     procedure idTypes(var Msg : TMessage); virtual + id_First + id_Types;
  116.     procedure idFinfo(var Msg : TMessage); virtual + id_First + id_Finfo;
  117.     procedure wmSysCommand(var Msg : TMessage); virtual + wm_First + wm_SysCommand;
  118.     destructor Done; virtual;
  119.   end;
  120.  
  121. function GetFileName(FilePath: PChar): PChar;
  122. var
  123.   P: PChar;
  124. begin
  125.   P := StrRScan(FilePath, '\');
  126.   if P = nil then P := StrRScan(FilePath, ':');
  127.   if P = nil then GetFileName := FilePath else GetFileName := P + 1;
  128. end;
  129.  
  130. function GetExtension(FilePath: PChar): PChar;
  131. var
  132.   P: PChar;
  133. begin
  134.   P := StrScan(GetFileName(FilePath), '.');
  135.   if P = nil then GetExtension := StrEnd(FilePath) else GetExtension := P;
  136. end;
  137.  
  138. function HasWildCards(FilePath: PChar): Boolean;
  139. begin
  140.   HasWildCards := (StrScan(FilePath, '*') <> nil) or
  141.     (StrScan(FilePath, '?') <> nil);
  142. end;
  143.  
  144. function MakeFileName(Dest, Source, Ext: PChar): PChar;
  145. begin
  146.   MakeFileName := StrLCat(StrLCopy(Dest, Source,
  147.     GetExtension(Source) - Source), Ext, fsPathName);
  148. end;
  149.  
  150. procedure FileDelete(FileName: PChar);
  151. var
  152.   F: file;
  153. begin
  154.   Assign(F, FileName);
  155.   Erase(F);
  156.   InOutRes := 0;
  157. end;
  158.  
  159. procedure FileRename(CurName, NewName: PChar);
  160. var
  161.   F: file;
  162. begin
  163.   Assign(F, CurName);
  164.   Rename(F, NewName);
  165.   InOutRes := 0;
  166. end;
  167.  
  168.  
  169. constructor TWinVerWindow.Init(AParent : PWindowsObject;ATitle : PChar);
  170. begin
  171.    TDlgWindow.Init(Nil, PChar(100));
  172.    StrCopy(FileName, '*.EXE');
  173.    Extension[0] := #0;
  174. end;
  175.  
  176. procedure TWinVerWindow.SetupWindow;
  177. var
  178.    hSysMenu: hMenu;
  179. begin
  180.    TDlgWindow.SetupWindow;
  181.    hSysMenu:=GetSystemMenu(HWindow, FALSE);
  182.    RemoveMenu(hSysMenu, sc_Maximize, mf_ByCommand);
  183.    RemoveMenu(hSysMenu, sc_Size, mf_ByCommand);
  184.    AppendMenu(hSysMenu, mf_separator, 0, Nil);
  185.    AppendMenu(hSysMenu, mf_string, id_About, '&About...');
  186.    SendDlgItemMessage(HWindow, id_Types, cb_AddString, 0, LongInt(PChar('EXE files')));
  187.    SendDlgItemMessage(HWindow, id_Types, cb_AddString, 0, LongInt(PChar('DLL files')));
  188.    SendDlgItemMessage(HWindow, id_Types, cb_SetCurSel, 0, 0);
  189.    CheckRadioButton(HWindow, id_Ver31, id_Ver30, id_Ver31);
  190.    UpdateListBoxes;
  191. end;
  192.  
  193. function TWinVerWindow.GetClassName : PChar;
  194. begin
  195.    GetClassName := TheApp;
  196. end;
  197.  
  198. procedure TWinVerWindow.GetWindowClass(var AWndClass : TWndClass);
  199. begin
  200.   TDlgWindow.GetWindowClass(AWndClass);
  201.   AWndClass.hIcon := LoadIcon(hInstance, PChar(800));
  202. end;
  203.  
  204. function TWinVerWindow.GetFileName: Boolean;
  205. var
  206.   FileLen: Word;
  207.   i: Integer;
  208. begin
  209.   GetFileName := False;
  210.   i:=LoWord(SendDlgItemMessage(HWindow, id_File, lb_getcursel,0,0));
  211.   SendDlgItemMessage(HWindow, id_File, lb_gettext,i,LongInt(@FileName)); 
  212.   FileExpand(FileName, FileName);
  213.   FileLen := StrLen(FileName);
  214.   if (FileName[FileLen - 1] = '\') or HasWildCards(FileName) or
  215.         (GetFocus = GetDlgItem(HWindow, id_Dir)) then begin
  216.     if FileName[FileLen - 1] = '\' then StrLCat(FileName, FileSpec, fsPathName);
  217.     if not UpdateListBoxes then MessageBeep(0);
  218.     Exit;
  219.   end;
  220.   StrLCat(StrLCat(FileName, '\', fsPathName), FileSpec, fsPathName);
  221.   if UpdateListBoxes then Exit;
  222.   FileName[FileLen] := #0;
  223.   AnsiLower(FileName);
  224.   GetFileName := True;
  225. end;
  226.  
  227.  
  228.  
  229. function TWinVerWindow.UpdateListBoxes: Boolean;
  230. var
  231.   Result: Integer;
  232.   Path: array[0..fsFileName] of Char;
  233. begin
  234.   UpdateListBoxes := False;
  235.   if DlgDirList(HWindow, FileName, id_File, id_Path, 0) <> 0 then
  236.   begin
  237.     DlgDirList(HWindow, '*.*', id_Dir, 0, $C010);
  238.     StrLCopy(FileSpec, FileName, fsFileSpec);
  239.     UpdateListBoxes := True;
  240.   end;
  241. end;
  242.  
  243. Procedure TWinVerWindow.idFile(var Msg : TMessage);
  244. begin
  245.   case Msg.LParamHi of
  246.     lbn_SelChange, lbn_DblClk:
  247.       begin
  248.         DlgDirSelect(HWindow, FileName, id_File);
  249.         if Msg.LParamHi = lbn_DblClk then idUpdate(Msg);
  250.       end;    
  251.  end;
  252. end;
  253.  
  254. Procedure TWinVerWindow.idDir(var Msg : TMessage);
  255. begin
  256.   case Msg.LParamHi of
  257.     lbn_SelChange, lbn_DblClk:
  258.       begin
  259.         DlgDirSelect(HWindow, FileName, id_Dir);
  260.         StrCat(FileName, FileSpec);
  261.         if Msg.LParamHi = lbn_DblClk then UpdateListBoxes;
  262.       end;
  263.   end;
  264. end;
  265.  
  266. function TWinVerWindow.UpdateFile(bVer31: Boolean) : Boolean;
  267. var
  268.   Stamp, N: Word;
  269.   L: Longint;
  270.   Buffer: Pointer;
  271.   TempName, BakName: array [0..fsPathName] of Char;
  272.   InputFile, OutputFile: file;
  273.   ExeHdr: tEXEHDR;
  274.   NewHdr: tNEWHDR;
  275. const
  276.    OutErr: PChar = 'Error writing output file.'#0;
  277.  
  278.   function Error(Stop: Boolean; Message: PChar): Boolean;
  279.   begin
  280.     if Stop then
  281.     begin
  282.       if Buffer <> Nil then FreeMem(Buffer, BufSize);
  283.       if TFileRec(InputFile).Mode <> fmClosed then Close(InputFile);
  284.       if TFileRec(OutputFile).Mode <> fmClosed then
  285.       begin
  286.         Close(OutputFile);
  287.         Erase(OutputFile);
  288.       end;
  289.       InOutRes := 0;
  290.       MessageBeep(mb_IconStop);
  291.       MessageBox(HWindow, Message, 'Error', mb_IconStop + mb_Ok);
  292.     end;
  293.     Error := Stop;
  294.   end;
  295.  
  296. begin
  297.   UpdateFile := False;
  298.   MakeFileName(TempName, FileName, '.$$$');
  299.   Assign(InputFile, FileName);
  300.   Assign(OutputFile, TempName);
  301.   Buffer := MemAlloc(BufSize);
  302.   if Error(Buffer = Nil, 'Not enough memory for copy buffer.') then Exit;
  303.   Reset(InputFile, 1);
  304.   if Error(IOResult <> 0, 'Cannot open input file.') then Exit;
  305.   Rewrite(OutputFile, 1);
  306.   if Error(IOResult <> 0, 'Cannot create output file.') then Exit;
  307.   L := FileSize(InputFile);
  308.   while L > 0 do
  309.   begin
  310.     if L > BufSize then N := BufSize else N := L;
  311.     BlockRead(InputFile, Buffer^, N);
  312.     if Error(IOResult <> 0, 'Error reading input file.') then Exit;
  313.     BlockWrite(OutputFile, Buffer^, N);
  314.     if Error(IOResult <> 0, OutErr) then Exit;
  315.     Dec(L, N);
  316.   end;
  317.   FreeMem(Buffer, BufSize);
  318.   Buffer:=Nil;
  319.   Close(InputFile);
  320.                         {Mark the File}
  321.   Seek(OutputFile,0);
  322.   BlockRead(OutputFile, ExeHdr, SizeOf(ExeHdr));
  323.   if Error(IOResult <> 0, OutErr) then Exit;
  324.   Seek(OutputFile,ExeHdr.ehPosNewHdr);
  325.   BlockRead(OutputFile, NewHdr, SizeOf(NewHdr));
  326.   if Error(IOResult <> 0, OutErr) then Exit;  
  327.                         {Do some verification on the EXE or DLL}
  328.      if (ExeHdr.ehSignature <> OLD_EXESign) or (NewHdr.nhExeType <> WIN_OS) or
  329.        (NewHdr.nhSignature <> NEW_EXESign) Then Begin
  330.          Error(TRUE, 'Unsupported File Format');
  331.          Exit;
  332.      end;
  333.   if bVer31 Then Stamp:=WIN_31 else Stamp:=WIN_30;
  334.   Seek(OutputFile,FilePos(Outputfile)-SizeOf(Word));
  335.   if Error(IOResult <> 0, OutErr) then Exit;
  336.   BlockWrite(OutputFile, Stamp, SizeOf(Stamp));
  337.   if Error(IOResult <> 0, OutErr) then Exit;
  338.   Close(OutputFile);
  339.   if StrPos(FileName, '.exe') <> Nil then 
  340.            MakeFileName(BakName, FileName, '.ex$')
  341.       else MakeFileName(BakName, FileName, '.dl$');
  342.   FileDelete(BakName);
  343.   FileRename(FileName, BakName);
  344.   FileRename(TempName, FileName);
  345.   UpdateFile := True;
  346. end;
  347.  
  348.  
  349. Procedure TWinVerWindow.idUpdate(var Msg : TMessage);
  350. var
  351.   bVer31: Boolean;
  352.   P: array[0..1] of PChar;
  353.   S: array[0..127] of Char;
  354.   InputFile : File;
  355. begin
  356.   if not GetFileName then Exit;
  357.   P[0] := FileName;
  358.   Assign( InputFile, FileName );
  359.   Reset(InputFile, 1);
  360.   if IOResult <> 0 then
  361.   begin
  362.     InOutRes := 0;
  363.     MessageBox(HWindow, 'Cannot open input file.', 'Error', mb_IconStop + mb_Ok);
  364.     Exit;
  365.   end;
  366.   Close(InputFile);
  367.   bVer31 := IsDlgButtonChecked(HWindow, id_Ver31) <> 0;
  368.   if bVer31 then P[1] := 'Windows 3.10' else P[1] := 'Windows 3.00';
  369.   WVSPrintF(S, 'Mark %s as a %s file?', P);
  370.   if MessageBox(HWindow, S, 'Update',
  371.     mb_IconQuestion + mb_YesNo + mb_DefButton2) <> id_Yes then Exit;
  372.   if ( UpdateFile(bVer31) = False ) then Exit;
  373.   WVSPrintF(S, 'Done marking %s (a backup file was created).', P);
  374.   MessageBox(HWindow, S, 'Success', mb_IconInformation + mb_Ok);
  375.   UpdateListBoxes;
  376. end;
  377.  
  378.  
  379. Procedure TWinVerWindow.idTypes(var Msg : TMessage);
  380. begin
  381.  if Msg.LParamHi = cbn_SelChange then begin
  382.    if SendDlgItemMessage(HWindow, id_Types, cb_GetCurSel, 0,0)=0 then
  383.       StrCopy(FileName,'*.EXE') else StrCopy(FileName,'*.DLL');
  384.    UpdateListBoxes;
  385.  end;
  386. end;
  387.  
  388.  
  389. Procedure TWinVerWindow.idFinfo(var Msg : TMessage);
  390. var
  391.    ExeHdr: tEXEHDR;
  392.    NewHdr: tNEWHDR;
  393.    InputFile:File;
  394.    S: Array [0..511] of Char;
  395.    W: Array [0..1] of Word;
  396.  
  397. begin
  398.    if not GetFileName then Exit;
  399.    {$I+}
  400.    Assign(InputFile, FileName);
  401.    Reset(InputFile, 1);
  402.    BlockRead(InputFile, ExeHdr, SizeOf(ExeHdr));
  403.    Seek(InputFile,ExeHdr.ehPosNewHdr);
  404.    BlockRead(InputFile, NewHdr, SizeOf(NewHdr));
  405.    Close(InputFile);
  406.    {$I-}
  407.      if (ExeHdr.ehSignature <> OLD_EXESign) or (NewHdr.nhExeType <> WIN_OS) or
  408.        (NewHdr.nhSignature <> NEW_EXESign) Then       
  409.          MessageBox(HWindow, 'Unsupported File Format', 'File Info', mb_ok or mb_IconStop)
  410.      else begin
  411.          StrCopy(S, FileName);
  412.          StrCat(S,#10'is marked for Windows v%d.%02d');
  413.          W[0]:=Hi(NewHdr.nhExpVer);
  414.          W[1]:=Lo(NewHdr.nhExpVer);
  415.          WvsPrintf(S, S, W);
  416.          MessageBox(HWindow, S, 'File Info', mb_ok or mb_IconInformation);
  417.      end;
  418. end;
  419.  
  420. procedure TWinVerWindow.wmSysCommand(var Msg : TMessage);
  421. begin
  422.    if Msg.wParam = id_About Then
  423.       MessageBox(HWindow, 'WinVer 1.0'#10'Copyright ⌐ 1992, Costas Kitsos',
  424.          'About WinVer', mb_ok or mb_IconInformation)
  425.    else DefWndProc(Msg);
  426. end;
  427.  
  428. destructor TWinVerWindow.Done;
  429. begin
  430.    TDlgWindow.Done;
  431. end;
  432.  
  433.  
  434. procedure TWinVerApp.InitMainWindow;
  435. begin
  436.   MainWindow := New(PWinVerWindow, Init(Nil, TheApp));
  437. end;
  438.  
  439.  
  440. procedure TWinVerApp.InitInstance;
  441. begin
  442.   TApplication.InitInstance;
  443. end;
  444.  
  445. var
  446.   App : TWinVerApp;
  447. begin
  448.   App.Init(TheApp);
  449.   App.Run;
  450.   App.Done;
  451. end.
  452.